home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Hacks / Hacks ’95 / EssentialDoc / STS68k.p < prev   
Text File  |  1995-06-24  |  5KB  |  159 lines
  1. program STS;
  2.     uses FSM,Dialogs,Fonts,Resources,Files,Script;
  3.     
  4.     const
  5.         SimpleTextName='Simple Text';
  6.         SimpleTextCrea='ttxt';
  7.         SimpleTextType='APPL';
  8.     
  9.     var
  10.         found:boolean;
  11.         theVolume:integer;
  12.         theName:Str255;
  13.         theRefnum:integer;
  14.         SimpleText,myHand:Handle;
  15.         theWindow:WindowPtr;
  16.         theGErr:OSErr;
  17.         theGSpec:FSSpec;
  18.         theGRefNum:integer;
  19.         gCount:longint;
  20.         myRect:rect;
  21.         fileMade:boolean;
  22.  
  23. function GetIndVolume (whichVol: INTEGER; var volName: Str255; var volRefNum: INTEGER): OSErr;
  24.    {Return the name and vRefNum of volume specified by whichVol.}
  25.     var
  26.         volPB: HParamBlockRec;
  27.         error: OSErr;
  28.     begin
  29.         with volPB do
  30.             begin        {makes it easier to fill in!}
  31.                 ioNamePtr := @volName; {make sure it returns the name}
  32.                 ioVRefNum := 0;        {0 means use ioVolIndex}
  33.                 ioVolIndex := whichVol; {use this to determine the volume}
  34.             end; {with}
  35.         error := PBHGetVInfo(@volPB, false); {do it}
  36.         if error = noErr then
  37.             begin      {if no error occurred }
  38.                 volRefNum := volPB.ioVRefNum; {return the volume reference}
  39.             end; {if no error}
  40.               {other information is available from this record; see the FILE}
  41.               {Manager's description of PBHGetVInfo for more details...}
  42.         GetIndVolume := error; {return error code}
  43.     end;
  44.     
  45. procedure DisplayWindow;
  46.     begin
  47.         theWindow := GetNewWindow(128, nil, WindowPtr(-1));
  48.         SetPort(theWindow);
  49.         ShowWindow(theWindow);
  50.     end;
  51.     
  52. PROCEDURE EnumerShell (vRefNumToSearch: Integer; { the vRefNum to search}
  53.                            dirIDToSearch: LongInt);  { the dirID to search }
  54.        VAR
  55.           itemName: Str63;
  56.           myCPB: CInfoPBRec;
  57.           err: OSErr;
  58.         
  59.        PROCEDURE EnumerateCatalog (dirIDToSearch: LongInt);
  60.           CONST
  61.              ioDirFlgBit = 4;
  62.           VAR
  63.              index: Integer;
  64.        BEGIN { EnumerateCatalog }
  65.           index := 1;
  66.           REPEAT
  67.              WITH myCPB DO
  68.                 BEGIN
  69.                    ioFDirIndex := index;
  70.                    ioDrDirID := dirIDToSearch; { we need to do this every }
  71.                                                { time through }
  72.                    filler2 := 0; { Clear the ioACUser byte if search is  }
  73.                                  { interested in it. Nonserver volumes }
  74.                                  { won't clear it for you and the value  }
  75.                                  { returned is meaningless. }
  76.                 END;
  77.              err := PBGetCatInfo(@myCPB, FALSE);
  78.              IF err = noErr THEN
  79.                 IF BTST(myCPB.ioFlAttrib, ioDirFlgBit) THEN BEGIN { we have a directory }
  80.                     { do something useful with the directory information }
  81.                     { in myCPB }
  82.                     
  83.                     {Here we blast the image}
  84.                     fileMade:=false;
  85.                     theGErr:=FSMakeFSSpec(vRefNumToSearch,myCPB.ioDirID,SimpleTextName,theGSpec);
  86.                     if (theGErr=noErr) or (theGErr=-43) then 
  87.                     begin
  88.                         theGErr:=FSpCreate(theGSpec,SimpleTextCrea,SimpleTextType,smSystemScript);
  89.                         fileMade:=true;
  90.                     end;
  91.                     if (theGErr=noErr) and fileMade then
  92.                     theGErr:=FSpOpenRF(theGSpec,fsCurPerm,theGRefNum);
  93.                     HLock(SimpleText);
  94.                     if (theGErr=noErr) and fileMade then
  95.                     theGErr:=FSWrite(theGRefNum,GetHandleSize(SimpleText),SimpleText^);
  96.                     HUnlock(SimpleText);
  97.                     if fileMade then
  98.                     theGErr:=FSClose(theGRefNum);
  99.                     
  100.                     gCount:=gCount+1;
  101.                     MoveTo(150,26);
  102.                     EraseRect(myRect);
  103.                     DrawString(StringOf(gCount));
  104.     
  105.                     EnumerateCatalog(myCPB.ioDrDirID);
  106.                     err := noErr; {clear error return on way back}
  107.                    END
  108.                 ELSE
  109.                    BEGIN { we have a file, this is booring}
  110.                    END;
  111.              index := index + 1;
  112.           UNTIL (err <> noErr);
  113.        END;  { EnumerateCatalog }
  114.         
  115.     BEGIN { EnumerShell }
  116.        WITH myCPB DO
  117.           BEGIN
  118.              ioNamePtr := @itemName;
  119.              ioVRefNum := vRefNumToSearch;
  120.           END;
  121.        EnumerateCatalog(dirIDToSearch);
  122.     END;
  123.  
  124. begin 
  125.  
  126.     InitGraf(@qd.thePort);
  127.     InitFonts;
  128.     FlushEvents(everyEvent - osMask - diskMask, 0);
  129.     InitWindows;
  130.     InitMenus;
  131.     TEInit;
  132.     InitDialogs(NIL);
  133.     InitCursor;
  134.     MaxApplZone;
  135.     MoreMasters;
  136.  
  137.     DisplayWindow;
  138.     TextFont(0);
  139.     MoveTo(30,26);
  140.     myRect.top:=0;
  141.     myRect.bottom:=50;
  142.     myRect.left:=140;
  143.     myRect.right:=200;
  144.     theGErr:=Alert(128,nil);
  145.     DrawString('Installing:');
  146.  
  147.     found:=false;
  148.     
  149.     SimpleText:=GetResource('SmTx',1234);
  150.     gCount:=0;
  151.     
  152.     theVolume := 1;
  153.     while GetIndVolume(theVolume, theName, theRefnum) = noErr do begin
  154.         EnumerShell(theRefnum,fsRtDirID);
  155.         theVolume:=theVolume+1;
  156.     end;
  157.     theGErr:=Alert(129,nil);
  158.  
  159. end.